home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / CMPLTPAS / LISTMAN.PAS < prev    next >
Pascal/Delphi Source File  |  1988-07-24  |  10KB  |  328 lines
  1. {--------------------------------------------------------------}
  2. {                          ListMan                             }
  3. {                                                              }
  4. {    Mailing list manager demo using dynamic (heap) storage    }
  5. {                                                              }
  6. {                             by Jeff Duntemann                }
  7. {                             Turbo Pascal V5.0                }
  8. {                             Last update 7/24/88              }
  9. {                                                              }
  10. {     From: COMPLETE TURBO PASCAL 5.0  by Jeff Duntemann       }
  11. {    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
  12. {--------------------------------------------------------------}
  13.  
  14. PROGRAM ListMan;
  15.  
  16. USES Crt;
  17.  
  18. TYPE
  19.   String30 = String[30];       { Using derived string types }
  20.   String6  = String[6];        { makes type NAPRec smaller }
  21.   String3  = String[3];
  22.  
  23.   NAPPtr = ^NAPRec;
  24.   NAPRec = RECORD
  25.              Name    : String30;
  26.              Address : String30;
  27.              City    : String30;
  28.              State   : String3;
  29.              Zip     : String6;
  30.              Next    : NAPPtr      { Points to next NAPRec }
  31.            END;                    { in a linked list }
  32.  
  33.   NAPFile = FILE OF NAPRec;
  34.  
  35.  
  36. VAR
  37.   Ch       : Char;
  38.   Root     : NAPPtr;
  39.   Quit     : Boolean;
  40.  
  41.  
  42.  
  43. {$I YES.SRC }      { Contains Yes }
  44.  
  45.  
  46. PROCEDURE ClearLines(First,Last : Integer);
  47.  
  48. VAR
  49.   I : Integer;
  50.  
  51. BEGIN
  52.   FOR I := First TO Last DO
  53.     BEGIN
  54.       GotoXY(1,I);
  55.       ClrEOL
  56.     END
  57. END;
  58.  
  59.  
  60.  
  61. PROCEDURE ShowRecord(WorkRec : NAPRec);
  62.  
  63. VAR
  64.   I : Integer;
  65.  
  66. BEGIN
  67.   ClearLines(17,22);  { Clear away anything in that spot before }
  68.   GotoXY(1,17);
  69.   WITH WorkRec DO
  70.     BEGIN
  71.       Writeln('>>Name:     ',Name);
  72.       Writeln('>>Address:  ',Address);
  73.       Writeln('>>City:     ',City);
  74.       Writeln('>>State:    ',State);
  75.       Writeln('>>Zip:      ',Zip)
  76.     END
  77. END;
  78.  
  79.  
  80. PROCEDURE CheckSpace;
  81.  
  82. VAR
  83.   Space      : Integer;
  84.   RealRoom   : Real;
  85.   RecordRoom : Real;
  86.  
  87. BEGIN
  88.   Space := MemAvail;    { MemAvail returns negative Integer for   }
  89.                         { space larger than 32,767.  Convert }
  90.                         { (to a real) by adding 65536 if negative }
  91.   IF Space < 0 THEN RealRoom := 65536.0 + Space ELSE RealRoom := Space;
  92.  
  93.   RealRoom := RealRoom * 16;   { Delete this line for Z80 versions! }
  94.                                { MemAvail for 8086 returns 16-byte  }
  95.                                { paragraphs, not bytes!! }
  96.  
  97.   RecordRoom := RealRoom / SizeOf(NAPRec);
  98.   ClearLines(2,3);
  99.   Writeln('>>There is now room for ',RecordRoom:6:0,' records in your list.');
  100. END;
  101.  
  102.  
  103. PROCEDURE ListDispose(VAR Root : NAPPtr);
  104.  
  105. VAR
  106.   Holder : NAPPtr;
  107.  
  108. BEGIN
  109.   GotoXY(27,10); Write('>>Are you SURE? (Y/N): ');
  110.   IF YES THEN
  111.     IF Root <> Nil THEN
  112.       REPEAT
  113.         Holder := Root^.Next;    { First grab the next record...       }
  114.         Dispose(Root);           { ...then dispose of the first one... }
  115.         Root := Holder           { ...then make the next one the first }
  116.       UNTIL Root = Nil;
  117.   ClearLines(10,10);
  118.   CheckSpace
  119. END;
  120.  
  121.  
  122. PROCEDURE AddRecords(VAR Root : NAPPtr);
  123.  
  124. VAR
  125.   I       : Integer;
  126.   Abandon : Boolean;
  127.   WorkRec : NAPRec;
  128.   Last    : NAPPtr;
  129.   Current : NAPPtr;
  130.  
  131. BEGIN
  132.   GotoXY(27,7); Write('<<Adding Records>>');
  133.   REPEAT               { Until user answers 'N' to "MORE?" question... }
  134.     ClearLines(24,24);
  135.     FillChar(WorkRec,SizeOf(WorkRec),CHR(0));  { Zero the record }
  136.     ClearLines(9,15);
  137.     GotoXY(1,9);
  138.     WITH WorkRec DO          { Fill the record with good data }
  139.       BEGIN
  140.         Write('>>Name:     '); Readln(Name);
  141.         Write('>>Address:  '); Readln(Address);
  142.         Write('>>City:     '); Readln(City);
  143.         Write('>>State:    '); Readln(State);
  144.         Write('>>Zip:      '); Readln(Zip)
  145.       END;
  146.     Abandon := False;
  147.                         { Here we traverse list to spot duplicates: }
  148.  
  149.     IF Root = Nil THEN      { If list is empty point Root to record }
  150.       BEGIN
  151.         New(Root);
  152.         WorkRec.Next := Nil;  { Make sure list is terminated by Nil }
  153.         Root^ := WorkRec;
  154.       END
  155.     ELSE                      { ...if there's something in list already   }
  156.       BEGIN
  157.         Current := Root;      { Start traverse at Root of list }
  158.         REPEAT
  159.           IF Current^.Name = WorkRec.Name THEN { If duplicate found }
  160.             BEGIN
  161.               ShowRecord(Current^);
  162.               GotoXY(1,15);
  163.               Write
  164. ('>>The record below duplicates the above entry''s Name.  Toss entry? (Y/N): ');
  165.               IF Yes THEN Abandon := True ELSE Abandon := False;
  166.               ClearLines(15,22)
  167.             END;
  168.           Last := Current;
  169.           Current := Current^.Next
  170.         UNTIL (Current = Nil) OR Abandon OR (Current^.Name > WorkRec.Name);
  171.  
  172.         IF NOT Abandon THEN            { Add WorkRec to the linked list  }
  173.           IF Root^.Name > WorkRec.Name THEN  { New Root item!     }
  174.             BEGIN
  175.               New(Root);               { Create a new dynamic NAPRec  }
  176.               WorkRec.Next := Last;    { Point new record at old Root }
  177.               Root^ := WorkRec         { Point new Root at WorkRec    }
  178.             END
  179.           ELSE
  180.             BEGIN
  181.               NEW(Last^.Next);         { Create a new dynamic NAPRec, }
  182.               WorkRec.Next := Current; { Points its Next to Current  }
  183.               Last^.Next^ := WorkRec;  { and assign WorkRec to it    }
  184.               CheckSpace               { Display remaining heapspace }
  185.             END;
  186.       END;
  187.     GotoXY(1,24); Write('>>Add another record to the list? (Y/N): ');
  188.   UNTIL NOT Yes;
  189. END;
  190.  
  191.  
  192. PROCEDURE LoadList(VAR Root : NAPPtr);
  193.  
  194. VAR
  195.   WorkName : String30;
  196.   WorkFile : NAPFile;
  197.   Current  : NAPPtr;
  198.   I        : Integer;
  199.   OK       : Boolean;
  200.  
  201. BEGIN
  202.   Quit := False;
  203.   REPEAT
  204.     ClearLines(10,10);
  205.     Write('>>Enter the Name of the file you wish to load: ');
  206.     Readln(WorkName);
  207.     IF Length(WorkName) = 0 THEN   { Hit (CR) only to abort LOAD }
  208.       BEGIN
  209.         ClearLines(10,12);
  210.         Quit := True
  211.       END
  212.     ELSE
  213.       BEGIN
  214.         Assign(WorkFile,WorkName);
  215.         {$I-} Reset(WorkFile); {$I+}
  216.         IF IOResult <> 0 THEN          { 0 = OK; 255 = File Not Found }
  217.           BEGIN
  218.             GotoXY(1,12);
  219.             Write('>>That file does not exist.  Please enter another.');
  220.             OK := False
  221.           END
  222.         ELSE OK := True                { OK means File Is open }
  223.       END
  224.     UNTIL OK OR Quit;
  225.   IF NOT Quit THEN
  226.     BEGIN
  227.       ClearLines(10,12);
  228.       Current := Root;
  229.       IF Root = Nil THEN               { If list is currently empty }
  230.         BEGIN
  231.           NEW(Root);                   { Load first record to Root^ }
  232.           Read(WorkFile,Root^);
  233.           Current := Root
  234.         END                            { If list is not empty, find the end: }
  235.       ELSE WHILE Current^.Next <> Nil DO Current := Current^.Next;
  236.       IF Root^.Next <> Nil THEN { If file contains more than 1 record }
  237.       REPEAT
  238.         NEW(Current^.Next);          { Read and add records to list }
  239.         Current := Current^.Next;    { until a record's Next field  }
  240.         Read(WorkFile,Current^)      { comes up Nil   }
  241.       UNTIL Current^.Next = Nil;
  242.       CheckSpace;
  243.       Close(WorkFile)
  244.     END
  245. END;
  246.  
  247.  
  248. PROCEDURE ViewList(Root : NAPPtr);
  249.  
  250. VAR
  251.   I        : Integer;
  252.   WorkFile : NAPFile;
  253.   Current  : NAPPtr;
  254.  
  255. BEGIN
  256.   IF Root = Nil THEN                 { Nothing is now in the list }
  257.     BEGIN
  258.       GotoXY(27,18);
  259.       Writeln('<<Your list is empty!>>');
  260.       GotoXY(26,20);
  261.       Write('>>Press (CR) to continue: ');
  262.       Readln
  263.     END
  264.   ELSE
  265.     BEGIN
  266.       GotoXY(31,7); Write('<<Viewing Records>>');
  267.       Current := Root;
  268.       WHILE Current <> Nil DO   { Traverse and display until Nil found }
  269.         BEGIN
  270.           ShowRecord(Current^);
  271.           GotoXY(1,23);
  272.           Write('>>Press (CR) to view Next record in the list: ');
  273.           Readln;
  274.           Current := Current^.Next
  275.         END;
  276.       ClearLines(19,22)
  277.     END
  278. END;
  279.  
  280.  
  281. PROCEDURE SaveList(Root : NAPPtr);
  282.  
  283. VAR
  284.   WorkName : String30;
  285.   WorkFile : NAPFile;
  286.   Current  : NAPPtr;
  287.   I        : Integer;
  288.  
  289. BEGIN
  290.   GotoXY(1,10);
  291.   Write('>>Enter the filename for saving out your list: ');
  292.   Readln(WorkName);
  293.   Assign(WorkFile,WorkName);   { Open the file for write access }
  294.   Rewrite(WorkFile);
  295.   Current := Root;
  296.   WHILE Current <> Nil DO      { Traverse and write }
  297.     BEGIN
  298.       Write(WorkFile,Current^);
  299.       Current := Current^.Next
  300.     END;
  301.   Close(WorkFile)
  302. END;
  303.  
  304.  
  305.  
  306. BEGIN       { MAIN }
  307.   ClrScr;
  308.   GotoXY(28,1); Write('<<Linked List Maker>>');
  309.   CheckSpace;
  310.   GotoXY(17,8);  Write('--------------------------------------------');
  311.   Root := Nil; Quit := False;
  312.   REPEAT
  313.     ClearLines(5,7);
  314.     ClearLines(9,24);
  315.     GotoXY(1,5);
  316.     Write
  317.     ('>>[L]oad, [A]dd record, [V]iew, [S]ave, [C]lear list, or [Q]uit: ');
  318.     Readln(Ch);                    { Get a command }
  319.     CASE Ch OF
  320.      'A','a' : AddRecords(Root);  { Parse the command & perform it }
  321.      'C','c' : ListDispose(Root);
  322.      'L','l' : LoadList(Root);
  323.      'S','s' : SaveList(Root);
  324.      'V','v' : ViewList(Root);
  325.      'Q','q' : Quit := True;
  326.     END; { CASE }
  327.   UNTIL Quit
  328. END.